home *** CD-ROM | disk | FTP | other *** search
/ CU Amiga Super CD-ROM 11 / CU Amiga Magazine's Super CD-ROM 11 (1997)(EMAP Images)(GB)(Track 1 of 3)[!][issue 1997-06].iso / cucd / programming / oberonv4 / source / system / reals.mod (.txt) < prev    next >
Oberon Text  |  1996-06-17  |  4KB  |  114 lines
  1. Syntax10.Scn.Fnt
  2. Syntax10b.Scn.Fnt
  3. ParcElems
  4. Alloc
  5. MODULE Reals; (** JT, RC, Bernd Moesli, cn, JR; 1996-06-17 RD *)
  6. IMPORT  S:=SYSTEM, HostSYS;
  7. (* Returns exponent of a REAL *)
  8. PROCEDURE Expo* (x: REAL): INTEGER;
  9. BEGIN
  10.     RETURN SHORT(ASH(S.VAL(LONGINT, x), -23) MOD 256)
  11. END Expo;
  12. (* Returns exponent of a LONGREAL *)
  13. PROCEDURE ExpoL* (x: LONGREAL): INTEGER;
  14. VAR i: LONGINT;
  15. BEGIN
  16.     IF HostSYS.BigEndianMachine THEN S.GET(S.ADR(x),i) ELSE S.GET(S.ADR(x)+4,i) END;
  17.     RETURN SHORT(ASH(i, -20) MOD 2048)
  18. END ExpoL;
  19. (* Sets exponent of a REAL *)
  20. PROCEDURE SetExpo*(e: INTEGER; VAR x: REAL);
  21. VAR i: LONGINT;
  22. BEGIN
  23.     S.GET(S.ADR(x), i);
  24.     i:= ASH(ASH(ASH(i, -31), 8) + e MOD 256, 23) + i MOD ASH(1, 23);
  25.     S.PUT(S.ADR(x), i)
  26. END SetExpo;
  27. (* Sets exponent of a LONGREAL *)
  28. PROCEDURE SetExpoL*(e: INTEGER; VAR x: LONGREAL);
  29. VAR i: LONGINT;
  30. BEGIN
  31.     IF HostSYS.BigEndianMachine THEN S.GET(S.ADR(x),i) ELSE S.GET(S.ADR(x)+4,i) END;
  32.     i:= ASH(ASH(ASH(i, -31), 11) + e MOD 2048, 20) + i MOD ASH(1, 20);
  33.     IF HostSYS.BigEndianMachine THEN S.PUT(S.ADR(x),i) ELSE S.PUT(S.ADR(x)+4,i) END
  34. END SetExpoL;
  35. (* Returns 10^e as REAL *)
  36. PROCEDURE Ten*(e: INTEGER): REAL;
  37. VAR r, power: LONGREAL;
  38. BEGIN
  39.     r := 1.0;
  40.     power := 10.0;
  41.     WHILE e > 0 DO
  42.         IF ODD(e) THEN r := r * power END;
  43.         power := power * power; e := e DIV 2
  44.     END;
  45.     RETURN SHORT(r)
  46. END Ten;
  47. (* Returns 10^e as LONGREAL *)
  48. PROCEDURE TenL*(e: INTEGER): LONGREAL;
  49. VAR r, power: LONGREAL;
  50. BEGIN
  51.     r := 1.0;
  52.     power := 10.0;
  53.     LOOP
  54.         IF ODD(e) THEN r := r * power END;
  55.         e := e DIV 2;
  56.         IF e <= 0 THEN RETURN r END;
  57.         power := power * power
  58. END TenL;
  59. (* Converts REAL x to n chars long string d using the decimal system *)
  60. PROCEDURE Convert*(x: REAL; n: INTEGER; VAR d: ARRAY OF CHAR);
  61. VAR i: LONGINT; k: INTEGER;
  62. BEGIN
  63.     i := ENTIER(x); k := 0;
  64.     WHILE k < n DO
  65.         d[k] := CHR(i MOD 10 + 48); i := i DIV 10; INC(k)
  66. END Convert;
  67. (* Converts LONGREAL x to n chars long string d using the decimal system *)
  68. PROCEDURE ConvertL* (x: LONGREAL; n: INTEGER; VAR d: ARRAY OF CHAR);
  69. VAR i, k, q: INTEGER;
  70. BEGIN
  71.     k:=0;
  72.     WHILE x>=10.0 DO x:=x/10.0; INC(k) END;
  73.     FOR i:=n TO k+1 DO d[i]:='0' END;
  74.     FOR i:=k TO 0 BY -1 DO
  75.         q:=SHORT(ENTIER(x));
  76.         d[i]:=CHR(48+q);
  77.         x:=(x-q)*10.0
  78. END ConvertL;
  79. (* Converts anything to string using the hexadecimal system *)
  80. PROCEDURE Unpack(VAR b, d: ARRAY OF S.BYTE);
  81. VAR i, len: LONGINT; k: SHORTINT;
  82. BEGIN
  83.     i := 0; len := LEN(b);
  84.     IF HostSYS.BigEndianMachine THEN    (* big endian *)
  85.         WHILE i < len DO
  86.             k := SHORT(ORD(S.VAL(CHAR, b[i])) DIV 16);
  87.             IF k > 9 THEN d[i*2] := k + 55 ELSE d[i*2] := k + 48 END;
  88.             k := SHORT(ORD(S.VAL(CHAR, b[i])) MOD 16);
  89.             IF k > 9 THEN d[i*2+1] := k + 55 ELSE d[i*2+1] := k + 48 END;
  90.             INC(i)
  91.         END
  92.     ELSE    (* little endian *)
  93.         WHILE i < len DO
  94.             k := SHORT(ORD(S.VAL(CHAR, b[len - i - 1])) DIV 16);
  95.             IF k > 9 THEN d[i*2] := k + 55 ELSE d[i*2] := k + 48 END;
  96.             k := SHORT(ORD(S.VAL(CHAR, b[len - i - 1])) MOD 16);
  97.             IF k > 9 THEN d[i*2+1] := k + 55 ELSE d[i*2+1] := k + 48 END;
  98.             INC(i)
  99.         END
  100. END Unpack;
  101. (* Converts REAL x string d using the hexadecimal system *)
  102. PROCEDURE ConvertH*(y: REAL; VAR d: ARRAY OF CHAR);
  103. TYPE Array4 = ARRAY 4 OF CHAR;    (* to avoid warning 1 *)
  104. BEGIN Unpack(S.VAL(Array4, y), d)
  105. END ConvertH;
  106. (* Converts LONGREAL x string d using the hexadecimal system *)
  107. PROCEDURE ConvertHL*(x: LONGREAL; VAR d: ARRAY OF CHAR);
  108. TYPE Array8 = ARRAY 8 OF CHAR;    (* to avoid warning 1 *)
  109. BEGIN Unpack(S.VAL(Array8, x), d)
  110. END ConvertHL;
  111. END Reals.
  112. Date    Author    Modification
  113. 1996-06-17    degner@pallas.amp.uni-hannover.de    Created first unified version.
  114.